Pascal Super Library/Pascal Super Library (CW International)(1997).bin/STRINGS/PSSTR108/PASSTR.PAS

Pascal/Delphi Source File | 1994-01-10 | 22.6 KB | 1,108 lines

{

Pascal String and Variable Procedures

Rev. 1.08

(c) Copyright 1993, Michael Gallias

Target: Real, Windows

Comment: Some procedures do work under Protected Mode, but not all of them.

To compile this with Turbo Pascal 6, simply remove the 'Const'
from the procedure defintions, e.g.

Procedure MyProc(Const MyVar:MyType);

becomes

Procedure MyProc(MyVar:MyType);

}

{$V-} {$B-}

Unit PasStr;

Interface

{$IFNDEF WINDOWS}

Uses CRT,Dos;

Const
  MaxXYSaves        =    5;                  {Max Number of Cursor Saves}

Type
  XYType            = (CursorX,CursorY);
  XYPosData         = Array[1..MaxXYSaves] of
                        Array [XYType] of Byte;
  KeyBufferFunction = (Clear,Save,Restore);

{$ENDIF}

Const
  LeftText          =    0;
  CentreText        =    1;
  CenterText        =    1;
  RightText         =    2;
  OutSideText       =    3;

Type
  TextFormats       = LeftText..RightText;
  JustifyFormats    = LeftText..OutSideText;
  CharSet           = Set Of Char;

{$IFDEF WINDOWS}

Procedure FSplit        (Path:String; Var Dir, Name, Ext:String);

{$ELSE}

Procedure SaveCursorSize(Var Data:Word);
Procedure RestCursorSize(Data:Word);
Procedure SaveXYPos     (Var Position:XYPosData);
Procedure RestXYPos     (Var Position:XYPosData);
Procedure CursorSize    (UpLim,DownLim:Byte);

Procedure PushCursorSize;
Procedure PopCursorSize;
Procedure PushXYPos;
Procedure PopXYPos;
Procedure PushTextColor;
Procedure PopTextColor;

Procedure KeyBuffer     (Option:KeyBufferFunction);

{$IFDEF MSDOS}

Function  MemoryCount   (P:Pointer):LongInt;
Procedure GetLowestOfs  (P:Pointer; Var S,O:Word);
Procedure AdjustPtr     (Var P:Pointer; Amount:LongInt);

{$ENDIF}

{$ENDIF}

Procedure SpacesToZeros (StIn:String; Var StOut:String);
Procedure RemoveLeading (StIn:String; Var StOut:String;
                         Const RemoveSet:CharSet);
Function  PosFrom       (SubS:String; StIn:String; FarIn:Byte):Byte;
Function  RevPosFrom    (SubS:String; StIn:String; FarIn:Byte):Byte;
Procedure UpperCase     (StIn:String; Var StOut:String);
Procedure LowerCase     (StIn:String; Var StOut:String);
Procedure CapWords      (StIn:String; Var StOut:String);
Procedure PadVar        (StIn:String; Var StOut:String; Count:Byte);
Procedure PadVarWith    (StIn:String; Var StOut:String; Count:Byte;
                         WithMe:Char);
Procedure PadFileName   (StIn:String; Var StOut:String);
Procedure FormatVar     (StIn:String; Var StOut:String;
                         Size:Byte; Format:TextFormats);
Procedure UnPadVar      (StIn:String; Var StOut:String);
Procedure UnPadVarRight (StIn:String; Var StOut:String);
Procedure UnPadVarLeft  (StIn:String; Var StOut:String);
Procedure RightJustify  (StIn:String; Var StOut:String;
                         Margin:Byte; JType:JustifyFormats);

Procedure ByteToHex     (Decimal:Byte; Var Hex:String);
Procedure WordToHex     (Decimal:Word; Var Hex:String);
Procedure LongIntToHex  (Decimal:LongInt; Var Hex:String);

Function  HexDigitValue (HexDigit:Char):Byte;
Procedure HexToByte     (Hex:String; Var Decimal:Byte; Var Code:Integer);
Procedure HexToWord     (Hex:String; Var Decimal:Word; Var Code:Integer);
Procedure HexToLongInt  (Hex:String; Var Decimal:LongInt; Var Code:Integer);

Function  Min           (I, J:LongInt):LongInt;
Function  Max           (I, J:LongInt):LongInt;

Function  AdjustMeter   (StartMeter1,EndMeter1,ValueMeter1,
                         StartMeter2,EndMeter2:LongInt):LongInt;

Procedure SwapBytes     (Var A,B:Byte);
Procedure SwapIntegers  (Var A,B:Integer);
Procedure SwapWords     (Var A,B:Word);
Procedure SwapLongInts  (Var A,B:LongInt);
Procedure SwapReals     (Var A,B:Real);
Procedure SwapStrings   (Var A,B:String);

{$IFOPT N+}

Procedure SwapSingles   (Var A,B:Single);
Procedure SwapDoubles   (Var A,B:Double);
Procedure SwapExtendeds (Var A,B:Extended);
Procedure SwapComps     (Var A,B:Comp);

{$ENDIF}

Implementation

{$IFDEF WINDOWS}

Procedure FSplit(Path:String; Var Dir, Name, Ext:String);

Var
  LastSlash  :Byte;

Begin
  LastSlash:=RevPosFrom('\',Path,Length(Path));
  If LastSlash=0 Then
  Begin
    LastSlash:=RevPosFrom(':',Path,Length(Path));
    If LastSlash>0 Then
    Begin                               {Found a Drive with Default Path}
      Dir:=Copy(Path,1,LastSlash);
      Delete(Path,1,LastSlash);
      LastSlash:=0;
    End
    Else                                {No Drive, No Path}
      Dir:='';
  End
  Else
  Begin                                 {A Path Found}
    Dir:=Copy(Path,1,LastSlash);
    Delete(Path,1,LastSlash);           {Delete Directory}
  End;

  LastSlash:=Pos('.',Path);
  If LastSlash>0 Then
  Begin
    Name:=Copy(Path,1,LastSlash-1);
    Ext:=Copy(Path,LastSlash,Length(Path)-(LastSlash-1));
  End
  Else
  Begin
    Name:=Path;
    Ext:='';
  End;
  If Length(Name)>8 Then Name:=Copy(Name,1,8);
  If Length(Ext)>4 Then Ext:=Copy(Ext,1,4);
End;

{$ELSE}

Var
  PushPopCursorSize:Array[1..MaxXYSaves] of Word;
  PushPopTextColor :Array[1..MaxXYSaves] of Word;
  PushPopCursorPos :XYPosData;

Procedure SaveCursorSize(Var Data:Word); Assembler;
Asm
  mov  ah,3
  int  10h
  les  di,Data
  mov  es:[di],cx
End;

Procedure RestCursorSize(Data:Word); Assembler;
Asm
  mov  ah,1
  mov  cx,Data
  int  10h
End;

Procedure SaveXYPos(Var Position:XYPosData);
{This saves the current cursor position and can store up to the last five}
{cursor positions}
{Number 'MaxXYSaves' is the lastest save}

Var
  X:Byte;   {Loop}

Begin
  For X:=1 to MaxXYSaves-1 do                    {Shift Cursor Saves up}
  Begin
      Position[X,CursorX]:=Position[X+1,CursorX];
      Position[X,CursorY]:=Position[X+1,CursorY];
  End;   {For X Loop}
  Position[5,CursorX]:=WhereX;      {Insert New Cursor Save Position}
  Position[5,CursorY]:=WhereY;
End;  {SaveXYPos}

Procedure RestXYPos(Var Position:XYPosData);
{This will restore up to five previously saved cursor positions}
{Number 'MaxXYSaves' is the position to be restored}

Var
  X:Byte;       {Loop}

Begin
  GotoXY(Position[MaxXYSaves,CursorX],Position[MaxXYSaves,CursorY]); {Goto Old Position}
  For X:=MaxXYSaves downto 2 do    {Shift up the cursor positions for the next restore}
  Begin
      Position[X,CursorX]:=Position[X-1,CursorX];
      Position[X,CursorY]:=Position[X-1,CursorY];
  End;  {For X Loop}
End;  {RestXYPos}

Procedure CursorSize(UpLim,DownLim:Byte); Assembler;
{Set the cursor size.  Send $20,$20 for no cursor}
Asm
  mov  ah,1
  mov  ch,UpLim
  mov  cl,DownLim
  int  10h
End;

Procedure PushCursorSize;

Var
  X:Word;

Begin
  For X:=1 to MaxXYSaves-1 do
    PushPopCursorSize[X]:=PushPopCursorSize[X+1];

  Asm
    mov  ah,3
    int  10h
    mov  X,cx
  End;

  PushPopCursorSize[MaxXYSaves]:=X;
End;

Procedure PopCursorSize;

Var
  X:Word;

Begin
  X:=PushPopCursorSize[MaxXYSaves];

  Asm
    mov  ah,1
    mov  cx,X
    int  10h
  End;

  For X:=MaxXYSaves DownTo 2 do
    PushPopCursorSize[X]:=PushPopCursorSize[X-1];
End;

Procedure PushXYPos;

Var
  X:Byte;

Begin
  For X:=1 to MaxXYSaves-1 do
    PushPopCursorPos[X]:=PushPopCursorPos[X+1];

  PushPopCursorPos[MaxXYSaves,CursorX]:=WhereX;
  PushPopCursorPos[MaxXYSaves,CursorY]:=WhereY;
End;

Procedure PopXYPos;

Var
  X:Byte;

Begin
  GotoXY(PushPopCursorPos[MaxXYSaves,CursorX],
         PushPopCursorPos[MaxXYSaves,CursorY]);

  For X:=MaxXYSaves DownTo 2 do
    PushPopCursorPos[X]:=PushPopCursorPos[X-1];
End;

Procedure PushTextColor;

Var
  X:Byte;

Begin
  For X:=1 to MaxXYSaves-1 do
    PushPopTextColor[X]:=PushPopTextColor[X+1];

  PushPopTextColor[MaxXYSaves]:=TextAttr;
End;

Procedure PopTextColor;

Var
  X:Word;

Begin
  TextAttr:=PushPopTextColor[MaxXYSaves];

  For X:=MaxXYSaves DownTo 2 do
    PushPopTextColor[X]:=PushPopTextColor[X-1];
End;

Procedure KeyBuffer(Option:KeyBufferFunction);

Type
  KeyBufType=Record
               Head:Word;
               Tail:Word;
               Data:Array[1..16] Of Word;
             End;

Const
  KeyBuf:KeyBufType=(Head:0;Tail:0;Data:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0));

Var
  P     :Pointer;

Begin
  P:=Ptr(Seg0040,$1A);
  Case Option Of
    Clear   :MemW[Seg0040:$1A]:=MemW[Seg0040:$1C];
    Save    :Move(P^,KeyBuf,SizeOf(KeyBuf));
    Restore :Move(KeyBuf,P^,SizeOf(KeyBuf));
  End;
End;

Function MemoryCount(P:Pointer):LongInt;
Begin
  MemoryCount:=LongInt(Seg(P^)) * 16 + Ofs(P^);
End;

Procedure GetLowestOfs(P:Pointer;Var S,O:Word);
Begin
  O:=Ofs(P^);
  S:=Seg(P^);
  If O<16 Then Exit;
  Inc(S,O Div 16);
  O:=O Mod 16;
End;

Procedure AdjustPtr(Var P:Pointer;Amount:LongInt);

Var
  X,
  Segt,
  Ofst  :Word;

Begin
  Segt:=Seg(P^);
  Ofst:=Ofs(P^);
  If Amount<0 Then
  Begin
    X:=$FFFF-Ofst;      {Want to Make Ofst as Big as Possible}
    X:=X - (X Mod 16);  {Round It to the Nearest 16}
    Dec(Segt,X Div 16); {Take it from the Segment}
    Inc(Ofst,X);        {Add it to the Offset}
  End
  Else
  Begin
    X:=Ofst - (Ofst Mod 16);    {Want to make Ofst as Small as Possible}
    Inc(Segt,X Div 16);         {Add it to the Segment}
    Dec(Ofst,X);                {Take it from the Offset}
  End;
  P:=Ptr(Segt,Ofst+Amount);
End;

{$ENDIF}

Procedure SpacesToZeros(StIn:String;Var StOut:String); Assembler;

Asm
  push  ds
  cld
  lds   si,StIn
  les   di,StOut
  lodsb
  stosb
  xor   ah,ah
  xchg  ax,cx
  jcxz  @Section3

@Section1:

  lodsb
  cmp   al,' '
  jne   @Section2
  mov   al,'0'

@Section2:

  stosb
  loop  @Section1

@Section3:

  pop   ds

End;

Procedure RemoveLeading(StIn:String; Var StOut:String;
                        Const RemoveSet:CharSet);

Var
  X     :Byte;

Begin
  X:=1;
  While (X<=Length(StIn)) And (StIn[X] in RemoveSet) do
    Inc(X);
  StOut:=Copy(StIn,X,Length(StIn)-X+1);
End;

Function PosFrom(SubS:String;StIn:String;FarIn:Byte):Byte;

Var
  NewPos:Byte;

Begin
  Delete(StIn,1,FarIn-1);
  NewPos:=Pos(SubS,StIn);
  If NewPos=0 Then
    PosFrom:=0
  Else
    PosFrom:=NewPos+FarIn-1;
End;

Function RevPosFrom(SubS:String;StIn:String;FarIn:Byte):Byte;

Var
  Mark  :Byte;
  Temp  :Byte;
  Chk   :String;

Begin
  If Length(SubS)>Length(StIn) Then
  Begin
    RevPosFrom:=0;
    Exit;
  End;

  Mark:=Length(StIn)-Length(SubS)+1;
  If Mark>FarIn Then Mark:=FarIn;
  Temp:=0;

  While (Mark>=1) And (Temp=0) do
  Begin
    Chk:=Copy(StIn,Mark,Length(SubS));
    If Chk=SubS Then
      Temp:=Mark
    Else
      Dec(Mark);
  End;
  RevPosFrom:=Temp;
End;

Procedure UpperCase(StIn:String;Var StOut:String); Assembler;

Asm
  push  ds
  cld
  lds   si,StIn
  les   di,StOut
  lodsb
  stosb
  xor   ah,ah
  xchg  ax,cx
  jcxz  @Section3

@Section1:

  lodsb
  cmp   al,'a'
  jb    @Section2
  cmp   al,'z'
  ja    @Section2
  sub   al,20h

@Section2:

  stosb
  loop  @Section1

@Section3:

  pop   ds

End;

Procedure LowerCase(StIn:String;Var StOut:String); Assembler;

Asm
  push  ds
  cld
  lds   si,StIn
  les   di,StOut
  lodsb
  stosb
  xor   ah,ah
  xchg  ax,cx
  jcxz  @Section3

@Section1:

  lodsb
  cmp   al,'A'
  jb    @Section2
  cmp   al,'Z'
  ja    @Section2
  add   al,20h

@Section2:

  stosb
  loop  @Section1

@Section3:

  pop   ds

End;

Procedure CapWords(StIn:String;Var StOut:String);

Var
  LastSpace  :Boolean;
  X          :Byte;

Begin
  StOut:=StIn;
  LastSpace:=True;
  For X:=1 to Length(StOut) do
  Begin
    If LastSpace Then StOut[X]:=UpCase(StOut[X]);

    If StOut[X]=' ' Then
      LastSpace:=True
    Else
      LastSpace:=False;
  End;
End;

Procedure PadVar(StIn:String;Var StOut:String;Count:Byte);

Var
   J:Byte;

Begin
  StOut:=StIn;
  For J:=1 to Count do
    StOut:=StOut+' ';
End;

Procedure PadVarWith(StIn:String;Var StOut:String;Count:Byte;WithMe:Char);

Var
   J:Byte;

Begin
  StOut:=StIn;
  For J:=1 to Count do
    StOut:=StOut+WithMe;
End;

Procedure PadFileName(StIn:String;Var StOut:String);

{Pads a file name to 12 characters.}

Var
  T1, T2, T3 :String;
  Dot        :Char;

Begin
  If StIn='.' Then
  Begin
    PadVar(StIn,StOut,11);
    Exit;
  End;

  If StIn='..' Then
  Begin
    PadVar(StIn,StOut,10);
    Exit;
  End;

  FSplit(StIn,T1,T2,T3);
  PadVar(T2,T2,8-Length(T2));
  Delete(T3,1,1);
  PadVar(T3,T3,3-Length(T3));
  If T3='   ' Then Dot:=' ' Else Dot:='.';
  StOut:=T1+T2+Dot+T3;
End;

Procedure FormatVar(StIn:String;Var StOut:String;
                    Size:Byte;Format:TextFormats);
Begin
  StOut:=StIn;

  If Format=LeftText Then
    While Length(StOut)<Size do
      StOut:=StOut+' '
  Else
    If Format=CentreText Then
    Begin
      While Length(StOut)<Size-1 do
        StOut:=' '+StOut+' ';
      Format:=RightText;
    End;

  If Format=RightText Then
    While Length(StOut)<Size do
      StOut:=' '+StOut;
End;

Procedure UnPadVar(StIn:String;Var StOut:String);
Begin
  StOut:=StIn;
  While (Length(StOut)>0) And (StOut[1]=' ') do
    Delete(StOut,1,1);
  While (Length(StOut)>0) And (StOut[Length(StOut)]=' ') do
    Delete(StOut,Length(StOut),1);
End;

Procedure UnPadVarRight(StIn:String;Var StOut:String);
Begin
  StOut:=StIn;
  While (Length(StOut)>0) And (StOut[Length(StOut)]=' ') do
    Delete(StOut,Length(StOut),1);
End;

Procedure UnPadVarLeft(StIn:String;Var StOut:String);
Begin
  StOut:=StIn;
  While (Length(StOut)>0) And (StOut[1]=' ') do
    Delete(StOut,1,1);
End;

Procedure RightJustify(StIn:String;Var StOut:String;
                       Margin:Byte;JType:JustifyFormats);

  Procedure RightJustifyLeft;

  Var
    EndLoop  :Boolean;
    Marker,
    SpPos    :Byte;

  Begin
    EndLoop:=False;
    While (Length(StOut)<Margin) And (Not EndLoop) do
    Begin
      Marker:=1;
      Repeat
        SpPos:=PosFrom(' ',StOut,Marker);
        If (SpPos=0) Or (SpPos=Length(StOut)) Then
        Begin
          If Marker=1 Then EndLoop:=True;
          Marker:=255
        End
        Else
        Begin
          Insert(' ',StOut,SpPos);
          Marker:=SpPos+2;
          While (StOut[Marker]=' ') And (Marker<Margin) do
            Inc(Marker);
        End;
      Until (Length(StOut)>=Margin) Or (Marker>Length(StOut)) Or EndLoop;
    End;
  End;

  Procedure RightJustifyRight;

  Var
    EndLoop  :Boolean;
    Marker,
    SpPos    :Byte;

  Begin
    EndLoop:=False;
    While (Length(StOut)<Margin) And (Not EndLoop) do
    Begin
      Marker:=Length(StOut);
      Repeat
        SpPos:=RevPosFrom(' ',StOut,Marker);
        If (SpPos=0) Or (SpPos=1) Then
        Begin
          If Marker=Length(StOut) Then EndLoop:=True;
          Marker:=0;
        End
        Else
        Begin
          Insert(' ',StOut,SpPos);
          Marker:=SpPos-1;
          While (StOut[Marker]=' ') And (Marker>1) do
            Dec(Marker);
        End;
      Until (Length(StOut)>=Margin) Or (Marker=0) Or EndLoop;
    End;
  End;

  Procedure RightJustifyCentre;

  Var
    EndLoop1,
    EndLoop2 :Boolean;
    Marker1,
    Marker2,
    SpPos    :Byte;

  Begin
    EndLoop1:=False;
    EndLoop2:=False;

    While (Length(StOut)<Margin) And (Not EndLoop1) And (Not EndLoop2) do
    Begin
      Marker1:=Length(StOut) Div 2;
      Marker2:=Marker1;
      If StOut[Marker1]=' ' Then Inc(Marker1);

      Repeat
        If Not ((Length(StOut)>=Margin) Or (Marker1>Length(StOut)) Or EndLoop1) Then
        Begin
          SpPos:=PosFrom(' ',StOut,Marker1);
          If (SpPos=0) Or (SpPos=Length(StOut)) Then
          Begin
            If Marker1=Length(StOut) Div 2 Then EndLoop1:=True;
            Marker1:=255
          End
          Else
          Begin
            Insert(' ',StOut,SpPos);
            Marker1:=SpPos+2;
            While (StOut[Marker1]=' ') And (Marker1<Margin) do
              Inc(Marker1);
          End;
        End;

        If Not ((Length(StOut)>=Margin) Or (Marker2=0) Or EndLoop2) Then
        Begin
          SpPos:=RevPosFrom(' ',StOut,Marker2);
          If (SpPos<=1) Then
          Begin
            If Marker2=Length(StOut) Div 2 Then EndLoop2:=True;
            Marker2:=0;
          End
          Else
          Begin
            Insert(' ',StOut,SpPos);
            If Marker1 <> 255 Then
              Inc(Marker1);               {Pushes Marker 1 Up 1 Space}
            Marker2:=SpPos-1;
            While (StOut[Marker2]=' ') And (Marker2>1) do
              Dec(Marker2);
          End;
        End;
      Until ((Length(StOut)>=Margin) Or (Marker1>Length(StOut)) Or EndLoop1) And
            ((Length(StOut)>=Margin) Or (Marker2=0) Or EndLoop2);
    End;
  End;

  Procedure RightJustifyOutSide;

  Var
    EndLoop1,
    EndLoop2 :Boolean;
    Marker1,
    Marker2,
    SpPos    :Byte;

  Begin
    EndLoop1:=False;
    EndLoop2:=False;

    While (Length(StOut)<Margin) And (Not EndLoop1) And (Not EndLoop2) do
    Begin
      Marker1:=1;
      Marker2:=Length(StOut);

      Repeat
        If Not ((Length(StOut)>=Margin) Or (Marker1>Length(StOut) Div 2) Or EndLoop1) Then
        Begin
          SpPos:=PosFrom(' ',StOut,Marker1);
          If (SpPos=0) Or (SpPos>Length(StOut) Div 2) Then
          Begin
            If Marker1=1 Then EndLoop1:=True;
            Marker1:=255
          End
          Else
          Begin
            Insert(' ',StOut,SpPos);
            Marker1:=SpPos+2;
            While (StOut[Marker1]=' ') And (Marker1<Length(StOut) Div 2) do
              Inc(Marker1);
          End;
        End;

        If Not ((Length(StOut)>=Margin) Or (Marker2<Length(StOut) Div 2) Or EndLoop2) Then
        Begin
          SpPos:=RevPosFrom(' ',StOut,Marker2);
          If (SpPos<=1) Then
          Begin
            If Marker2<=Length(StOut) Div 2 Then EndLoop2:=True;
            Marker2:=0;
          End
          Else
          Begin
            Insert(' ',StOut,SpPos);
            If Marker1 <> 255 Then
              Inc(Marker1);               {Pushes Marker 1 Up 1 Space}
            Marker2:=SpPos-1;
            While (StOut[Marker2]=' ') And (Marker2>=Length(StOut) Div 2) do
              Dec(Marker2);
          End;
        End;
      Until ((Length(StOut)>=Margin) Or (Marker1>Length(StOut) Div 2) Or EndLoop1) And
            ((Length(StOut)>=Margin) Or (Marker2<=Length(StOut) Div 2) Or EndLoop2);
    End;
  End;

Begin
  StOut:=StIn;
  Case JType Of
    LeftText    :RightJustifyLeft;
    RightText   :RightJustifyRight;
    CentreText  :RightJustifyCentre;
    OutSideText :RightJustifyOutSide;
  End;
End;

Procedure ByteToHex(Decimal:Byte; Var Hex:String);

Var
  X     :Byte;

Begin
  Hex[0]:=#2;
  X:=Decimal Div 16;
  Case X Of
     0 ..  9  :Hex[1]:=Chr(Ord('0')+X);
    10 .. 15  :Hex[1]:=Chr(Ord('A')+X-10);
  End;
  X:=Decimal Mod 16;
  Case X Of
     0 ..  9  :Hex[2]:=Chr(Ord('0')+X);
    10 .. 15  :Hex[2]:=Chr(Ord('A')+X-10);
  End;
End;

Procedure WordToHex(Decimal:Word; Var Hex:String);

Var
  P1, P2        :String[2];

Begin
  ByteToHex(Hi(Decimal),P1);
  ByteToHex(Lo(Decimal),P2);
  Hex:=P1+P2;
End;

Procedure LongIntToHex(Decimal:LongInt; Var Hex:String);

Var
  T     :String[2];
  B     :Byte;
  x     :Byte;

Begin
  Hex:='';
  For x:=1 to 4 do
  Begin
    B:=(Decimal Shl ( (x-1) * 8 )) And 255;
    ByteToHex(B,T);
    Hex:=Hex+T;
  End;
End;

Function HexDigitValue(HexDigit:Char):Byte;

{Value of an UPPERCASE Hex Digit}

Begin
  Case HexDigit Of
    '0'..'9'  :HexDigitValue:=Ord(HexDigit)-Ord('0');
    'A'..'F'  :HexDigitValue:=Ord(HexDigit)-Ord('A') + 10;
  End;
End;

Procedure HexToByte(Hex:String; Var Decimal:Byte; Var Code:Integer);

Var
  X     :LongInt;

Begin
  HexToLongInt(Hex, X, Code);
  If Code=0 Then
    If (X>=0) And (X<=255) Then Decimal:=X Else Code:=254;
End;

Procedure HexToWord(Hex:String; Var Decimal:Word; Var Code:Integer);

Var
  X     :LongInt;

Begin
  HexToLongInt(Hex, X, Code);
  If Code=0 Then
    If (X>=0) And (X<=65535) Then Decimal:=X Else Code:=254;
End;

Procedure HexToLongInt(Hex:String; Var Decimal:LongInt; Var Code:Integer);

Var
  x,y   :Byte;

Begin
  Code:=0;
  If Hex[1]='$' Then Delete(Hex,1,1);
  If UpCase(Hex[Length(Hex)])='H' Then Delete(Hex,Length(Hex),1);

  UpperCase(Hex,Hex);
  For x:=1 to Length(Hex) do
    If Not (Hex[x] in ['0'..'9','A'..'F']) Then Code:=X;

  If Length(Hex)>8 Then Code:=255;
  If Code=0 Then
  Begin
    Decimal:=0;
    y:=0;
    For x:=Length(Hex) downto 1 do
    Begin
      Decimal:=Decimal Or (HexDigitValue(Hex[x]) Shl y);
      Inc(y,4);
    End;
  End;
End;

Function Min(I, J:LongInt):LongInt;
Begin
  If I>J Then Min:=J Else Min:=I;
End;

Function Max(I, J:LongInt):LongInt;
Begin
  If I>J Then Max:=I Else Max:=J;
End;

Function AdjustMeter(StartMeter1,EndMeter1,ValueMeter1,
                     StartMeter2,EndMeter2:LongInt):LongInt;
Begin
  AdjustMeter:=(((EndMeter2-StartMeter2)*(ValueMeter1-StartMeter1)) Div
               (EndMeter1-StartMeter1))+StartMeter2;
End;

Procedure SwapBytes(Var A,B:Byte); Assembler;
Asm
  push  ds
  les   di,A
  lds   si,B
  mov   al,es:[di]
  mov   bl,al             {A into BX}
  mov   al,ds:[si]        {B into AX}
  mov   es:[di],al
  mov   al,bl
  mov   ds:[si],al
  pop   ds
End;

Procedure SwapIntegers(Var A,B:Integer); Assembler;
Asm
  push  ds
  les   di,A
  lds   si,B
  mov   ax,es:[di]
  mov   bx,ax             {A into BX}
  mov   ax,ds:[si]        {B into AX}
  mov   es:[di],ax
  mov   ax,bx
  mov   ds:[si],ax
  pop   ds
End;

Procedure SwapWords(Var A,B:Word); Assembler;
Asm
  push  ds
  les   di,A
  lds   si,B
  mov   ax,es:[di]
  mov   bx,ax             {A into BX}
  mov   ax,ds:[si]        {B into AX}
  mov   es:[di],ax
  mov   ax,bx
  mov   ds:[si],ax
  pop   ds
End;

Procedure SwapLongInts(Var A,B:LongInt);

Var
  C:LongInt;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

Procedure SwapReals(Var A,B:Real);

Var
  C:Real;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

Procedure SwapStrings(Var A,B:String);

Var
  C:String;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

{$IFOPT N+}

Procedure SwapSingles(Var A,B:Single);

Var
  C:Single;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

Procedure SwapDoubles(Var A,B:Double);

Var
  C:Double;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

Procedure SwapExtendeds(Var A,B:Extended);

Var
  C:Extended;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

Procedure SwapComps(Var A,B:Comp);

Var
  C:Comp;

Begin
  C:=A;
  A:=B;
  B:=C;
End;

{$ENDIF}

End.